home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0014_Edit Long String.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  5KB  |  148 lines
  1.  
  2. { code to allow input of strings that are wider than the crt or
  3.   the current window.  Will scroll the window to allow continued input
  4.  
  5. This is for entering large strings in a smaller
  6. screen (do you have a monitor that's 255 chars wide???). In any case, I'll
  7. give it to you now. So long as you make the viewport larger than the
  8. length limit of the string, you will have no scrolling and no problem. I
  9. will simply have to fix the scrolling later. Modify as you wish, you may
  10. find it useful. CRT.TPU is required. }
  11.  
  12.  
  13. uses crt;
  14. const     ksins = 128; {insert mode on}
  15. var       kbshift :    byte absolute $40:$17; {shift key status}
  16. Function Getkey:word;
  17. assembler; asm
  18.  xor ah,ah
  19.  int $16
  20. end;
  21. Procedure Beep(Hz,Ms:word);
  22. begin
  23.  sound(hz);
  24.  delay(ms);
  25.  nosound;
  26. end;
  27. function edstr(var instring;x,y,viewport,color,limit:byte):boolean;
  28. var
  29.  wmax,wmin:word;
  30.  showpos,xmax,ymax,editpos,viewpos,oldx,oldy,oldcolor:byte;
  31.  update,insmode:boolean;
  32.  editstr:string absolute instring;
  33.  key:record
  34.   ch,scan:byte;
  35.  end;
  36. begin
  37.   wmax:=windmax; {store window}
  38.   wmin:=windmin; {store window}
  39.   oldcolor:=textattr; {store color}
  40.   oldx:=wherex; {store cursor}
  41.   oldy:=wherey; {store cursor}
  42.   window(1,1,80,25);
  43.   window(1,1,80,50);
  44.   xmax:=windmax and 255 + 1;
  45.   ymax:=windmax shr 8 + 1;
  46.   {verify viewport dimensions}
  47.   if (y<=ymax) and (x+viewport-1<=xmax) and (viewport<>0) then begin
  48.   edstr:=true;
  49.   window(x,y,x+viewport-1,y); {set window}
  50.   textattr:=color; {set new color}
  51.   viewpos:=1; {init view pos}
  52.   editpos:=1; {init edit pos}
  53.   clrscr; {clear window}
  54.   kbshift:=kbshift or ksins; {force insert}
  55.   update:=true;
  56.   if editstr[0]>char(limit) then editstr[0]:=char(limit);
  57.   repeat {loop until Enter pressed}
  58.    {update display}
  59.    if update then begin
  60.     gotoxy(1,1);
  61.     inc(windmax); {prevents CRT scrolling}
  62.     showpos:=viewpos;
  63.     while (showpos<=length(editstr)) and (showpos<=viewpos+viewport-1) do
  64.     begin
  65.      write(editstr[showpos]);
  66.      inc(showpos);
  67.     end;
  68.     dec(windmax); {restore window after temporary anti-scroll}
  69.     clreol;
  70.    end;
  71.    update:=true;
  72.    gotoxy((editpos-1) mod viewport+1,1); {proper cursor edit pos}
  73.    word(key):=getkey; {get key}
  74.    insmode:=kbshift and ksins<>0; {check insert mode}
  75.    {if insert then flat cursor else block cursor}
  76.    case key.ch of {check key char}
  77.     0:case key.scan of {check key scan code}
  78.      $47:editpos:=1; {home}
  79.      $4B:if editpos<>1 then dec(editpos); {left}
  80.      $4D:if (editpos<>limit) and (editpos<>length(editstr)+1) then
  81.          inc(editpos); {right}
  82.      $4F:if length(editstr)=limit then editpos:=limit
  83.          else editpos:=length(editstr)+1; {end}
  84.      $53:delete(editstr,editpos,1); {del}
  85.      $77:{^Home, del till start of line}
  86.          begin
  87.           delete(editstr,1,editpos-1);
  88.           editpos:=1;
  89.          end;
  90.      $75:delete(editstr,editpos,255); {^End, del till end of line}
  91.      $73:{^Left, seek word left}
  92.          if editpos=1 then update:=false
  93.          else repeat
  94.           dec(editpos);
  95.          until (editpos=1) or (editstr[editpos-1]=' ');
  96.      $74:{^Right, seek word right}
  97.          if (editpos=limit) or (editpos=length(editstr)+1) then
  98.           update:=false
  99.          else repeat
  100.           inc(editpos);
  101.          until (editstr[editpos-1]=' ') or (editpos=limit)
  102.           or (editpos=length(editstr)+1);
  103.      else update:=false; {do not waste time updating screen}
  104.     end; {check key scan code}
  105.     8:if editpos>1 then begin {backspace}
  106.      dec(editpos);
  107.      delete(editstr,editpos,1);
  108.     end
  109.     else update:=false;
  110.     32..255:begin {valid chars}
  111.      if insmode or (length(editstr)+1=editpos) then
  112.       {inserted if using insert mode OR if overstrike AND at string end}
  113.       if (length(editstr)<>limit) then insert(char(key.ch),editstr,editpos)
  114.       else beep(5000,10) {error: string full}
  115.      else editstr[editpos]:=char(key.ch); {overstrike char}
  116.      if editpos<>limit then inc(editpos); {inc pos within limit}
  117.     end; {valid chars}
  118.     else update:=false; {do not waste time updating screen}
  119.    end; {check key char}
  120.  
  121.    {update scroll window}
  122.    while editpos<viewpos do dec(viewpos,viewport); {left}
  123.    while editpos>=viewpos+viewport do inc(viewpos,viewport); {right}
  124.   until key.ch=13; {enter ends loop/input}
  125.   textattr:=oldcolor; {minimal screen clean up}
  126.   clrscr;
  127.  end {valid viewport}
  128.  else edstr:=false; {invalid viewport}
  129.  windmin:=wmin; {restore window}
  130.  windmax:=wmax; {restore window}
  131.  textattr:=oldcolor; {restore color}
  132.  gotoxy(oldx,oldy); {restore cursor}
  133. end; {edstr}
  134.  
  135. VAR
  136.      aStr : STRING;
  137.  
  138. BEGIN
  139.     IF edstr(aStr,   { the value to edit }
  140.              10,     { Col (x) }
  141.              10,     { Row (y) }
  142.              50,     { window width max }
  143.              31,     { input color }
  144.              100)    { maximum length of input }
  145.          THEN WriteLn(aStr);
  146. END.
  147.  
  148.